home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue68 / System / fmMain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-03-06  |  3.6 KB  |  135 lines
  1. unit fmMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Save: TButton;
  12.     Restore: TButton;
  13.     Button1: TButton;
  14.     ColorDialog1: TColorDialog;
  15.     Button2: TButton;
  16.     ItemNames: TListBox;
  17.     procedure FormCreate(Sender: TObject);
  18.     procedure FormDestroy(Sender: TObject);
  19.     procedure SaveClick(Sender: TObject);
  20.     procedure RestoreClick(Sender: TObject);
  21.     procedure Button1Click(Sender: TObject);
  22.     procedure Button2Click(Sender: TObject);
  23.   private
  24.     { Private declarations }
  25.     hDeskWin: hWnd;
  26.     dmResponse: Integer;
  27.     dmData: PChar;
  28.     procedure WMCopyData (var Message: TWMCopyData); message wm_CopyData;
  29.     function PendOnDeskTopMessage (Msg, wParam, lParam: Integer): PChar;
  30.     procedure SetTextColor (Value: LongInt);
  31.     function GetTextColor: LongInt;
  32.     function GetItemCount: Integer;
  33.     function GetItemCaption (Index: Integer): String;
  34.   public
  35.     { Public declarations }
  36.   end;
  37.  
  38. var
  39.   Form1: TForm1;
  40.  
  41. implementation
  42.  
  43. {$R *.DFM}
  44.  
  45. uses CommCtrl, DeskManMessages;
  46.  
  47. function DeskManagerLoad (AppWindow: hWnd): Bool; stdcall; external 'DeskManager.dll';
  48. function DeskManagerUnload: Bool; stdcall; external 'DeskManager.dll';
  49. function DeskManagerListView: HWnd; stdcall; external 'DeskManager.dll';
  50. function DeskManagerShellThread: DWord; stdcall; external 'DeskManager.dll';
  51.  
  52. procedure TForm1.FormCreate(Sender: TObject);
  53. var
  54.     Msg: TMsg;
  55. begin
  56.     DeskManagerLoad (Handle);
  57.     GetMessage (Msg, 0, 0, 0);
  58.     hDeskWin := FindWindow (Nil, 'Delphi Desktop 2001');
  59.     if hDeskWin = 0 then raise Exception.Create ('Trouble at ''mill');
  60. end;
  61.  
  62. procedure TForm1.FormDestroy(Sender: TObject);
  63. begin
  64.     SendMessage (hDeskWin, wm_Close, 0, 0);
  65.     while IsWindow (hDeskWin) do Application.ProcessMessages;
  66.     DeskManagerUnload;
  67. end;
  68.  
  69. function TForm1.GetItemCount: Integer;
  70. begin
  71.     Result := ListView_GetItemCount (DeskManagerListView);
  72. end;
  73.  
  74. function TForm1.GetTextColor: LongInt;
  75. begin
  76.     Result := SendMessage (hDeskWin, DM_GetTextColor, 0, 0);
  77. end;
  78.  
  79. procedure TForm1.SetTextColor (Value: LongInt);
  80. begin
  81.     if GetTextColor <> Value then SendMessage (hDeskWin, DM_SetTextColor, 0, Value);
  82. end;
  83.  
  84. procedure TForm1.WMCopyData (var Message: TWMCopyData);
  85. begin
  86.     // Make sure it's from the desktop manager DLL
  87.     if Message.From = hDeskWin then with Message, Message.CopyDataStruct^ do begin
  88.         ReallocMem (dmData, cbData);
  89.         Move (lpData^, dmData^, cbData);
  90.         dmResponse := dwData;
  91.         Result := Integer (True);
  92.     end;
  93. end;
  94.  
  95. function TForm1.PendOnDeskTopMessage (Msg, wParam, lParam: Integer): PChar;
  96. begin
  97.     dmResponse := -1;
  98.     PostMessage (hDeskWin, Msg, wParam, lParam);
  99.     while dmResponse <> Msg do Application.ProcessMessages;
  100.     Result := dmData;
  101. end;
  102.  
  103. function TForm1.GetItemCaption (Index: Integer): String;
  104. begin
  105.     Result := '';
  106.     if (Index >= 0) and (Index < GetItemCount) then
  107.         Result := StrPas (PendOnDesktopMessage (DM_GetItemText, Index, 0));
  108. end;
  109.  
  110. procedure TForm1.SaveClick(Sender: TObject);
  111. begin
  112.     //SendMessage (hDeskWin, wm_App, 0, 1);
  113. end;
  114.  
  115. procedure TForm1.RestoreClick(Sender: TObject);
  116. begin
  117.     //SendMessage (hDeskWin, wm_App, 0, 0);
  118. end;
  119.  
  120. procedure TForm1.Button1Click(Sender: TObject);
  121. begin
  122.     if ColorDialog1.Execute then SetTextColor (ColorDialog1.Color);
  123. end;
  124.  
  125. procedure TForm1.Button2Click(Sender: TObject);
  126. var
  127.     Idx: Integer;
  128. begin
  129.     ItemNames.Clear;
  130.     for Idx := 0 to GetItemCount - 1 do
  131.         ItemNames.Items.Add (GetItemCaption (Idx));
  132. end;
  133.  
  134. end.
  135.